{-# OPTIONS -XTypeSynonymInstances #-}

module Text.ParserCombinators.TableWithConfig (
   TableConfigParser, TPError,
   readTableWithConfig, get,
   liftL, liftR,
 ) where

import Control.Monad.Error
import Control.Monad.Reader
import Data.Either
import Data.Either.Utils
import Data.ConfigFile ( Get_C, ConfigParser(..), CPError, SectionSpec, OptionSpec, readstring, emptyCP )

import Text.ParserCombinators.Table

import qualified Text.ParserCombinators.Parsec.Char as C
import qualified Data.ConfigFile as CF

type TableConfigParser = ConfigParser
data TPError           = CPError CPError | ParseError ParseError deriving Show

instance Error TPError where
    noMsg    = CPError $ noMsg
    strMsg x = CPError $ strMsg x

{-
get :: (Get_C a, MonadReader ConfigParser (Either TPError)) => SectionSpec -> OptionSpec ->  Either TPError a
get s o = do
  cp <- ask
  liftL $ CF.get cp s o
-}

get cp s = liftL . CF.get cp s

liftL = either (throwError.CPError   ) (return)
liftR = either (throwError.ParseError) (return)

readTableWithConfig :: String -> ReaderT TableConfigParser (Either TPError) (SParser a) -> Either TPError (ConfigParser, [a]) 
readTableWithConfig s m = do
  (h, t) <- liftR $ parse parser "" s
  cp     <- liftL $ readstring emptyCP {optionxform = map id} h
  r      <- liftR . parseTable t =<< runReaderT m cp
  return (cp, r)

parser = do
  c <- line `manyTill` try (eof <|> (lookAhead $ C.string "#--" >> return ()))
  s <- anyToken `manyTill` eof
  return (concat c,s)

line :: Parser String
line = do
  skipMany ( C.char '#' <|> C.space )
  s <- many $ C.noneOf "\n"
  c <- option "" $ C.string "\n"
  return (s ++ c)